home *** CD-ROM | disk | FTP | other *** search
/ BBS Toolkit / BBS Toolkit.iso / wildcat / wcbbs.zip / BBSLIST.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-02-17  |  6.1 KB  |  224 lines
  1. (******************)
  2. (******************)
  3. Program BBSLIST;
  4. (******************)
  5. (******************)
  6.  
  7. Uses DOS,CRT;
  8.  
  9. Const
  10.  PathLength = 65;
  11.  Line = '░░░░░░░░░░▒▒▒▒▒▒▒▒▒▒▓▓▓▓▓▓▓▓▓▓██████████████████▓▓▓▓▓▓▓▓▓▓▒▒▒▒▒▒▒▒▒▒░░░░░░░░░';
  12.  BBSLine = 'Name                      Phone         Soft                Baud   R  G  F  A';
  13.  
  14. Type
  15.  FileName = String[PathLength];
  16.  
  17. Var
  18.  InFileName,CfgFileName,
  19.  BBSFileName,OutFileName : FileName;
  20.  
  21.  InFile,CfgFile,BBSFile,
  22.  TxtFile                 : Text;
  23.  
  24.  TmpStr,BBSName          : String;
  25.  
  26.  LineClr,NameClr,FlagClr,
  27.  TitleClr,FstClr,AltClr  : String[4];
  28.  
  29.  I                       : Integer;
  30.  
  31. (******************)
  32. Procedure CONFIG;
  33.  
  34. Begin
  35.  TmpStr := ' ';
  36.  LineClr := '@00@';
  37.  NameClr := '@00@';
  38.  FlagClr := '@00@';
  39.  TitleClr := '@00@';
  40.  FstClr := '@00@';
  41.  AltClr := '@00@';
  42.  BBSName := '                                 List of BBSes';
  43.  If ParamCount = 0 then CfgFileName := 'SYSOP.CFG'
  44.   else Begin
  45.    TmpStr := ParamStr(1);
  46.    For I:= 0 to Length(TmpStr) do CfgFileName[I] := Upcase(TmpStr[I]);
  47.   End;
  48.  Assign(CfgFile,CfgFileName);
  49.  {$I-}
  50.  Reset(CfgFile);
  51.  {$I+}
  52.  If IOResult <> 0 then
  53.   Begin
  54.    Writeln(CfgFileName,' does not exist.');
  55.    Halt;
  56.   End;
  57.   Readln(CfgFile,TmpStr);
  58.   For I := 1 to Length(TmpStr) do BBSName[I] := TmpStr[I];
  59.   Readln(CfgFile,TmpStr);
  60.   For I := 0 to Length(TmpStr) do InFileName[I] := Upcase(TmpStr[I]);
  61.   Readln(CfgFile,TmpStr);
  62.   For I := 0 to Length(TmpStr) do BBSFileName[I] := Upcase(TmpStr[I]);
  63.   Readln(CfgFile,TmpStr);
  64.   For I := 0 to Length(TmpStr) do OutFileName[I] := Upcase(TmpStr[I]);
  65.   Readln(CfgFile,TmpStr);
  66.   For I := 1 to 2 do LineClr[I+1] := Upcase(TmpStr[I]);
  67.   Readln(CfgFile,TmpStr);
  68.   For I := 1 to 2 do NameClr[I+1] := Upcase(TmpStr[I]);
  69.   Readln(CfgFile,TmpStr);
  70.   For I := 1 to 2 do FlagClr[I+1] := Upcase(TmpStr[I]);
  71.   Readln(CfgFile,TmpStr);
  72.   For I := 1 to 2 do TitleClr[I+1] := Upcase(TmpStr[I]);
  73.   Readln(CfgFile,TmpStr);
  74.   For I := 1 to 2 do FstClr[I+1] := Upcase(TmpStr[I]);
  75.   Readln(CfgFile,TmpStr);
  76.   For I := 1 to 2 do AltClr[I+1] := Upcase(TmpStr[I]);
  77.  Close(CfgFile);
  78. End;
  79.  
  80. (******************)
  81. Procedure ChkInFile;
  82.  
  83. Begin
  84.  Assign(InFile,InFileName);
  85.  {$I-}
  86.  Reset(InFile);
  87.  {$I+}
  88.  If IOResult <> 0 then
  89.   Begin
  90.    Writeln(InFileName,' does not exist.');
  91.    Halt;
  92.   End;
  93. End;
  94.  
  95. (******************)
  96. Procedure BBSGen;
  97.  
  98. Var
  99.  BBSStr                 : String;
  100.  Toggle                 : Boolean;
  101.  
  102. Begin
  103.  Toggle := False;
  104.  Assign(BBSFile,BBSFileName);
  105.  Rewrite(BBSFile);
  106.  Writeln(BBSFile,'@CLS@',LineClr,Line);
  107.  Writeln(BBSFile,NameClr,BBSName);
  108.  Writeln(BBSFile,LineClr,Line);
  109.  Writeln(BBSFile);
  110.  Writeln(BBSFile,FlagClr,'Flags:  R = Offline Reader      G = Games      F = Files      A = Adults');
  111.  Writeln(BBSFile);
  112.  Writeln(BBSFile,TitleClr,'BBS Name                  Phone #       Software            Baud   R  G  F  A');
  113.  Writeln(BBSFile);
  114.  Reset(InFile);
  115.  While NOT EOF(InFile) do
  116.   Begin
  117.    BBSStr := BBSLine;
  118.    For I := 1 to 5 do Readln(InFile);
  119.    Readln(InFile,TmpStr);
  120.    If TmpStr[12] = 'Y' then
  121.     Begin
  122.      Readln(InFile,TmpStr);
  123.      For I := 1 to (Length(TmpStr)-10) do BBSStr[I] := TmpStr[I+10];
  124.      Readln(InFile,TmpStr);
  125.      For I := 1 to (Length(TmpStr)-10) do BBSStr[I+26] := TmpStr[I+10];
  126.      Readln(InFile,TmpStr);
  127.      For I := 1 to (Length(TmpStr)-10) do BBSStr[I+40] := TmpStr[I+10];
  128.      Readln(InFile,TmpStr);
  129.      For I := 1 to (Length(TmpStr)-10) do BBSStr[I+60] := TmpStr[I+10];
  130.      Readln(InFile,TmpStr);
  131.      BBSStr[68] := TmpStr[11];
  132.      Readln(InFile,TmpStr);
  133.      BBSStr[71] := TmpStr[11];
  134.      Readln(InFile,TmpStr);
  135.      BBSStr[74] := TmpStr[11];
  136.      Readln(InFile,TmpStr);
  137.      BBSStr[77] := TmpStr[11];
  138.      If Toggle then
  139.       Begin
  140.        Writeln(BBSFile,AltClr,BBSStr);
  141.        Toggle := False;
  142.       End
  143.       else Begin
  144.        Writeln(BBSFile,FstClr,BBSStr);
  145.        Toggle := True;
  146.       End;
  147.      Readln(InFile);
  148.     End;
  149.   End;
  150.  Writeln(BBSFile,'@PAUSE@');
  151.  Writeln(BBSFile,LineClr,Line);
  152.  Writeln(BBSFile,NameClr,'   SysOps, fill out the questionaire at the Main Menu to add your system.');
  153.  Writeln(BBSFile,LineClr,Line);
  154.  Writeln(BBSFile,NameClr,'                     Product of Worst Knightmare Software');
  155.  Writeln(BBSFile,LineClr,Line);
  156.  Close(BBSFile);
  157. End;
  158.  
  159. (******************)
  160. Procedure TXTGen;
  161.  
  162. Var
  163.  BBSStr                 : String;
  164.  
  165. Begin
  166.  Assign(TXTFile,OutFileName);
  167.  Rewrite(TXTFile);
  168.  Writeln(TXTFile,Line);
  169.  Writeln(TXTFile,BBSName);
  170.  Writeln(TXTFile,Line);
  171.  Writeln(TXTFile);
  172.  Writeln(TXTFile,'Flags:  R = Offline Reader      G = Games      F = Files      A = Adults');
  173.  Writeln(TXTFile);
  174.  Writeln(TXTFile,'BBS Name                  Phone #       Software            Baud   R  G  F  A');
  175.  Writeln(TXTFile);
  176.  Reset(InFile);
  177.  While NOT EOF(InFile) do
  178.   Begin
  179.    BBSStr := BBSLine;
  180.    For I := 1 to 5 do Readln(InFile);
  181.    Readln(InFile,TmpStr);
  182.    If TmpStr[12] = 'Y' then
  183.     Begin
  184.      Readln(InFile,TmpStr);
  185.      For I := 1 to (Length(TmpStr)-10) do BBSStr[I] := TmpStr[I+10];
  186.      Readln(InFile,TmpStr);
  187.      For I := 1 to (Length(TmpStr)-10) do BBSStr[I+26] := TmpStr[I+10];
  188.      Readln(InFile,TmpStr);
  189.      For I := 1 to (Length(TmpStr)-10) do BBSStr[I+40] := TmpStr[I+10];
  190.      Readln(InFile,TmpStr);
  191.      For I := 1 to (Length(TmpStr)-10) do BBSStr[I+60] := TmpStr[I+10];
  192.      Readln(InFile,TmpStr);
  193.      BBSStr[68] := TmpStr[11];
  194.      Readln(InFile,TmpStr);
  195.      BBSStr[71] := TmpStr[11];
  196.      Readln(InFile,TmpStr);
  197.      BBSStr[74] := TmpStr[11];
  198.      Readln(InFile,TmpStr);
  199.      BBSStr[77] := TmpStr[11];
  200.      Writeln(TXTFile,BBSStr);
  201.      Readln(InFile);
  202.     End;
  203.   End;
  204.  Writeln(TXTFile,Line);
  205.  Writeln(TXTFile,'   SysOps, fill out the questionaire at the Main Menu to add your system.');
  206.  Writeln(TXTFile,Line);
  207.  Writeln(TXTFile,'                             Product of Worst Knightmare Software');
  208.  Writeln(TxtFile,Line);
  209.  Close(TXTFile);
  210. End;
  211.  
  212. (******************)
  213. (******************)
  214. (****** Main ******)
  215. (******************)
  216. (******************)
  217. Begin
  218.  ClrScr;
  219.  Config;
  220.  ChkInFile;
  221.  If BBSFileName <> 'N' then BBSGen;
  222.  If OutFileName <> 'N' then TXTGen;
  223.  Close(InFile);
  224. End.